home *** CD-ROM | disk | FTP | other *** search
- #! /usr/bin/perl
- #
- use strict;
- use warnings;
- use Cwd 'abs_path';
-
- # Debconf may not be around here.
- my $have_debconf = 0;
- my $capb;
-
- eval {require Debconf::Client::ConfModule;};
- if ( ! $@ )
- {
- $have_debconf++;
- import Debconf::Client::ConfModule ':all';
- version('2.0');
- $capb=capb("backup");
- }
-
- $|=1;
- # Predefined values:
- my $version = "3.2.0-4-486";
- my $link_in_boot = "";
- my $kimage = "vmlinuz";
- my $initrd = "YES"; # initrd kernel
- my $postrm_hook = ''; #Normally we do not
- my $kernel_arch = "x86";
- my $ramdisk = "=MK"; # List of tools to create initial ram fs.
- my $package_name = "linux-image-$version";
-
- #known variables
- my $image_dest = "/";
- my $realimageloc = "/boot/";
- my $CONF_LOC = '/etc/kernel-img.conf';
-
- chdir('/') or die "could not chdir to /:$!\n";
-
-
- if (-r "$CONF_LOC" && -f "$CONF_LOC" ) {
- if (open(CONF, "$CONF_LOC")) {
- while (<CONF>) {
- chomp;
- s/\#.*$//g;
- next if /^\s*$/;
-
- $link_in_boot = "" if /link_in_boot\s*=\s*(no|false|0)\s*$/i;
-
- $link_in_boot = "Yes" if /link_in_boot\s*=\s*(yes|true|1)\s*$/i;
-
- $image_dest = "$1" if /image_dest\s*=\s*(\S+)/i;
- $postrm_hook = "$1" if /postrm_hook\s*=\s*(\S+)/i;
- }
- close CONF;
- }
- }
-
- if ($link_in_boot) {
- $image_dest = $realimageloc;
- }
-
- $image_dest = "$image_dest/";
- $image_dest =~ s|/+$|/|o;
-
- # The destdir may be gone by now.
- if (-d "$image_dest") {
- chdir("$image_dest") or die "could not chdir to $image_dest:$!\n";
- }
-
- $ENV{KERNEL_ARCH}=$kernel_arch if $kernel_arch;
-
-
- ######################################################################
- ######################################################################
- ############
- ######################################################################
- ######################################################################
- sub remove_sym_link {
- my $bad_image = $_[0];
-
- warn "Removing symbolic link $bad_image \n";
- warn "You may need to re-run your boot loader\n";
- # Remove the dangling link
- unlink "$bad_image";
- }
-
- ######################################################################
- ######################################################################
- ############
- ######################################################################
- ######################################################################
- sub CanonicalizePath {
- my $path = join '/', @_;
- my @work = split '/', $path;
- my @out;
- my $is_absolute;
-
- if (@work && $work[0] eq "") { $is_absolute = 1; shift @work; }
-
- while (@work) {
- my $seg = shift @work;
- if ($seg eq "." || $seg eq "") {
- } elsif ($seg eq "..") {
- if (@out && $out[-1] ne "..") {
- pop @out;
- } else {
- # Leading "..", or "../..", etc.
- push @out, $seg;
- }
- } else {
- push @out, $seg;
- }
- }
-
- unshift @out, "" if $is_absolute;
- return join('/', @out);
- }
-
- ######################################################################
- ######################################################################
- ############
- ######################################################################
- ######################################################################
- # This removes dangling symlinks. What do we do about hard links? Surely a
- # something with the nane $image_dest . "$kimage" ought not to be left behind?
- sub image_magic {
- my $kimage = $_[0];
- my $image_dest = $_[1];
-
- if (-l "$kimage") {
- # There is a symbolic link
- my $force_move = 0;
- my $vmlinuz_target = readlink "$kimage";
- my $real_target = '';
- $real_target = abs_path($vmlinuz_target) if defined ($vmlinuz_target);
- if (!defined($vmlinuz_target) || ! -f "$real_target") {
- # what, a dangling symlink?
- warn "The link " . $image_dest . "$kimage is a damaged link\n";
- # Remove the dangling link
- &remove_sym_link("$kimage");
- }
- else {
- my $canonical_target = CanonicalizePath("$vmlinuz_target");
- if (! -e $canonical_target) {
- warn "The link " . $image_dest . "$kimage is a dangling link\n";
- &remove_sym_link("$kimage");
- }
- }
- }
- }
-
- # set the env var stem
- $ENV{'STEM'} = "linux";
-
- sub exec_script {
- my $type = shift;
- my $script = shift;
- print STDERR "Running $type hook script $script.\n";
- system ("$script $version $realimageloc$kimage-$version") &&
- print STDERR "User $type hook script [$script] ";
- if ($?) {
- if ($? == -1) {
- print STDERR "failed to execute: $!\n";
- }
- elsif ($? & 127) {
- printf STDERR "died with signal %d, %s coredump\n",
- ($? & 127), ($? & 128) ? 'with' : 'without';
- }
- else {
- printf STDERR "exited with value %d\n", $? >> 8;
- }
- }
- }
- sub run_hook {
- my $type = shift;
- my $script = shift;
- if ($script =~ m,^/,) {
- # Full path provided for the hook script
- if (-x "$script") {
- &exec_script($type,$script);
- }
- else {
- warn "The provided $type hook script [$script] could not be run.\n";
- }
- }
- else {
- # Look for it in a safe path
- for my $path ('/bin', '/sbin', '/usr/bin', '/usr/sbin') {
- if (-x "$path/$script") {
- &exec_script($type, "$path/$script");
- return 0;
- }
- }
- # No luck
- print STDERR "Could not find $type hook script [$script].\n";
- warn "Looked in: '/bin', '/sbin', '/usr/bin', '/usr/sbin'\n";
- }
- }
-
- my $options;
- for (@ARGV) {
- s,','\\'',g;
- $options .= " '$_'";
- }
- $ENV{'DEB_MAINT_PARAMS'}="$options";
-
- ## Run user hook script here, if any
- if ($postrm_hook) {
- &run_hook("postrm", $postrm_hook);
- }
- if (-d "/etc/kernel/postrm.d") {
- warn "Examining /etc/kernel/postrm.d .\n";
- system ("run-parts --verbose --exit-on-error --arg=$version " .
- "--arg=$realimageloc$kimage-$version " .
- "/etc/kernel/postrm.d") &&
- die "Failed to process /etc/kernel/postrm.d";
- }
- if (-d "/etc/kernel/postrm.d/$version") {
- warn "Examining /etc/kernel/postrm.d/$version .\n";
- system ("run-parts --verbose --exit-on-error --arg=$version " .
- "--arg=$realimageloc$kimage-$version " .
- "/etc/kernel/postrm.d/$version") &&
- die "Failed to process /etc/kernel/postrm.d/$version";
- }
-
- # purge initramfs and related
- if ($ARGV[0] !~ /upgrade/) {
- if (-f $realimageloc . "initrd.img-$version") {
- unlink $realimageloc . "initrd.img-$version";
- }
- if (-f $realimageloc . "initrd.img-$version.bak") {
- unlink $realimageloc . "initrd.img-$version.bak";
- }
- if (-f "/var/lib/initramfs-tools/$version") {
- unlink "/var/lib/initramfs-tools/$version";
- }
- # check and remove damaged and dangling symlinks
- image_magic($kimage, $image_dest);
- image_magic($kimage . ".old", $image_dest);
- image_magic("initrd.img", $image_dest) if $initrd;
- image_magic("initrd.img.old", $image_dest) if $initrd;
- }
-
-
- # Ignore all invocations except when called on to purge.
- exit 0 unless $ARGV[0] =~ /purge/;
-
- my $ret = purge();
-
- my @files_to_remove = qw{
- modules.dep modules.isapnpmap modules.pcimap
- modules.usbmap modules.parportmap
- modules.generic_string modules.ieee1394map
- modules.ieee1394map modules.pnpbiosmap
- modules.alias modules.ccwmap modules.inputmap
- modules.symbols modules.ofmap
- modules.seriomap modules.*.bin
- modules.softdep modules.devname
- };
-
- foreach my $extra_file (@files_to_remove) {
- for (glob("/lib/modules/$version/$extra_file")) {
- unlink;
- }
- }
-
- if (-d "/lib/modules/$version" ) {
- system ("rmdir", "/lib/modules/$version");
- }
-
- exit 0;
-
- __END__
-